perm filename REVERB.F4[M11,LCS] blob sn#414623 filedate 1979-01-26 generic text, type T, neo UTF8
      SUBROUTINE REVERB
	COMMON /LM/L(10),M(10),NSAMX  /ROUT/ROUT(1) /MM/MM,NSM
	1 /NT/RNT(1)
	EQUIVALENCE (L1,L(1)),(L2,L(2)),(L3,L(3))
	DIMENSION DL(4050),X(8),LD(8),JDS(8)
C NEXT ARE THE VARIOUS DELAY TIMES AND MULTIPIERS.  
	DATA LD/801, 901, 1011, 1123, 123, 43, 23, 13/
	1,  X/0.827, 0.805, 0.783, 0.764, 0.7, 0.7, 0.7, 0.7/
C BE SURE THAT SUM OF ALL LD VALUES IS LESS OR = TO TOTAL DL ARRAY.

C  FOLLOWING IS A TYPICAL MUS10 REVERB INST.
C	INSTRUMENT REV;
C      REV1(R,801,.827,D1);  REV1(R,901,.805,D2);
C      REV1(R,1011,.783,D3); REV1(R,1123,.764,D4);
C      REV2(U1+U2+U3+U4,123,.7,D5);  REV2(U5,43,.7,D6); 
C	REV2(U6,23,.7,D7);  REV2(U6,13,.7,D8);
C      R←0;OUTA←OUTA+U8;  END;

	IF(RNT(L3).EQ.0)GO TO 4
C SET P3 TO 1 TO INITIALIZE REVERB.
	RNT(L3)=0
	DO 5 K=1,4050
5	DL(K)=0
CLEAR DELAY ARRAYS
	DO 6 K=1,8
6	JDS(K)=0
C SET ALL POINTERS TO ZERO
4	DO 1 K=0,NSAMX
1	ROUT(K+L2)=0
CLEAR  OUTPUT ARRAY.
	N=1
	J=L1
	MM=0
	NSM=NSAMX+1
	DO 2 K=1,8
	CALL REVX(DL(N),LD(K),X(K),JDS(K),ROUT(L2),ROUT(J))
	IF(K.NE.4)GO TO 2
	J=L2
	MM=-1  
C THESE CHANGES COME FOR 'REV2' PROCESS
2	N=N+LD(K)
C UPDATES POINTER IN DELAY ARRAY.
	DO 3 K=0,NSAMX
3	ROUT(L1+K)=0
C CLEAR INPUT ARRAY.
	END

	SUBROUTINE REVX(DL,LD,X,JDS,DOUT,DIN)
	COMMON /MM/MM,NSM
	DIMENSION DL(1),DOUT(1),DIN(1)
	JD=JDS
	DO 1 K=1,NSM    
	JD=JD+1
	DS=DL(JD)
	IF(MM.NE.0)GO TO 2
 	DOUT(K)=DS+DOUT(K)
C GET OUTPUT FROM DELAY LOOP AND ADD IT INTO OUTPUT BLOCK.
	DL(JD)=DS*X+DIN(K)
C ADD SIGNAL INTO DELAY LOOP
	GO TO 1
2	DN=DIN(K)
	DX=(DS-DN)*X
	DOUT(K)=DS+DX
C THIS IS 'REV2' PROCESS
	DL(JD)=DX+DN
C ADD SIGNAL INTO DELAY LOOP
1	IF(JD.GE.LD)JD=0
	JDS=JD
	END